library(arules)
library(gridExtra)
library(arulesViz)
library(plyr)El objetivo de esta sección es el de construir reglas de asociación mediante las cuáles poder obtener información de qué productos se compran juntos, es decir, si un cliente compra un producto determinado, es muy probable que también compre otro producto. Así, se pueden proponer sugerencias para la cadena de tiendas. Dichas sugerencias se presentan al final de esta sección.
Para obtener las reglas de asociación, trabajaremos con la tabla cl_prod, resultante de la unión de las tablas cliente y producto.
Seleccionamos las variables cod.cliente y descripcion para la aplicación de las reglas de asociación. Así, nos quedamos con los datos de qué clientes compran qué productos.
# dataframe con el que vamos a trabajar
df_reglas_asociacion <- cl_prod %>% select(cod.cliente, descripcion)
# volvemos a convertir cod.cliente en factor
df_reglas_asociacion$cod.cliente <- as.factor(df_reglas_asociacion$cod.cliente)
# adecuamos los levels
df_reglas_asociacion2 <- df_reglas_asociacion
levels(df_reglas_asociacion2$descripcion) <- str_trim(levels(df_reglas_asociacion2$descripcion))Creamos una tabla de transacciones a partir del dataframe de partida:
transactionData <- ddply(df_reglas_asociacion2, "cod.cliente",
function(df_reglas_asociacion2)paste(df_reglas_asociacion2$descripcion,
collapse = ","))
#Eliminamos cod.cliente porque no se va a utilizar
transactionData$cod.cliente <- NULL
# cambiamos el nombre de la columna
names(transactionData) <- c("Productos")Escribimos el resultado en un .csv y lo volvemos a leer desde R:
# # TRABAJO
# write.csv(transactionData,"C:/Users/rtrinchet/Desktop/gourmetdb/market_basket_transactions.csv", quote = FALSE, row.names = FALSE, fileEncoding = "UTF-8")
#
#
# tr <- read.transactions("C:/Users/rtrinchet/Desktop/gourmetdb/market_basket_transactions.csv", format = 'basket', sep=',', encoding = 'UTF-8')
# CASA
write.csv(transactionData,"C:/Users/rtyu_/Downloads/gourmetdb-20190102T170333Z-001/gourmetdb/market_basket_transactions.csv", quote = FALSE, row.names = FALSE, fileEncoding = "UTF-8")
tr <- read.transactions("C:/Users/rtyu_/Downloads/gourmetdb-20190102T170333Z-001/gourmetdb/market_basket_transactions.csv", format = 'basket', sep=',', encoding = 'UTF-8')Se muestra un resumen de la matriz de transacciones:
summary(tr)## transactions as itemMatrix in sparse format with
## 3924 rows (elements/itemsets/transactions) and
## 907 columns (items) and a density of 0.01633714
##
## most frequent items:
## Tinto Reserva 95 Camembert Tinto Gran Reserva 91
## 1833 1687 1478
## Tinto Reserva 94 Bordeaux 97 (Other)
## 1465 1385 50297
##
## element (itemset/transaction) length distribution:
## sizes
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18
## 91 135 162 147 189 181 196 212 203 206 171 172 155 139 116 132 113 107
## 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36
## 101 70 61 89 80 59 47 71 48 38 46 44 38 28 27 27 19 21
## 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54
## 15 19 13 8 10 8 9 5 11 4 4 4 4 2 2 6 9 5
## 55 57 58 60 61 62 63 64 65 67 68 69 72 73 75 77 78 79
## 5 2 2 1 5 5 1 2 3 4 1 1 1 1 3 2 1 1
## 80 82 89 90
## 1 1 1 1
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.00 7.00 12.00 14.82 20.00 90.00
##
## includes extended item information - examples:
## labels
## 1 1989 Brut Champagne
## 2 Abondance
## 3 Almendrados de las Monjas Clarisas
Los items con mayor número de ocurrencias se pueden observar en el siguiente gráfico:
itemFrequencyPlot(tr,topN=12,type="absolute", col="lightcyan2")A continuación, tratamos de tomar una decisión sobre qué niveles de soporte y de confianza debemos utilizar. Para ello, mostramos una gráfica comparativa que presenta, para cada nivel de soporte, la evolución del número de reglas encontradas para cada nivel de confianza.
# Support and confidence values
supportLevels <- c(0.1, 0.05, 0.03, 0.01)
confidenceLevels <- c(0.9, 0.8, 0.7, 0.6, 0.5, 0.4, 0.3, 0.2, 0.1)
# Empty integers
rules_sup10 <- integer(length=9)
rules_sup5 <- integer(length=9)
rules_sup3 <- integer(length=9)
rules_sup1 <- integer(length=9)
# maxima longitud
max_leng <- c(2)
# Apriori algorithm with a support level of 10%
for (i in 1:length(confidenceLevels)) {
rules_sup10[i] <- length(apriori(tr, parameter=list(sup=supportLevels[1],
conf=confidenceLevels[i], target="rules", maxlen=max_leng)))
}
# Apriori algorithm with a support level of 5%
for (i in 1:length(confidenceLevels)) {
rules_sup5[i] <- length(apriori(tr, parameter=list(sup=supportLevels[2],
conf=confidenceLevels[i], target="rules", maxlen=max_leng)))
}
# Apriori algorithm with a support level of 3%
for (i in 1:length(confidenceLevels)) {
rules_sup3[i] <- length(apriori(tr, parameter=list(sup=supportLevels[3],
conf=confidenceLevels[i], target="rules", maxlen=max_leng)))
}
# Apriori algorithm with a support level of 1%
for (i in 1:length(confidenceLevels)) {
rules_sup1[i] <- length(apriori(tr, parameter=list(sup=supportLevels[4],
conf=confidenceLevels[i], target="rules", maxlen=max_leng)))
}# Number of rules found with a support level of 10%
plot1 <- qplot(confidenceLevels, rules_sup10, geom=c("point", "line"),
xlab="Confidence level", ylab="Number of rules found",
main="Apriori with a support level of 10%") +
theme_bw()
# Number of rules found with a support level of 5%
plot2 <- qplot(confidenceLevels, rules_sup5, geom=c("point", "line"),
xlab="Confidence level", ylab="Number of rules found",
main="Apriori with a support level of 5%") +
scale_y_continuous() +
theme_bw()
# Number of rules found with a support level of 3%
plot3 <- qplot(confidenceLevels, rules_sup3, geom=c("point", "line"),
xlab="Confidence level", ylab="Number of rules found",
main="Apriori with a support level of 3%") +
scale_y_continuous() +
theme_bw()
# Number of rules found with a support level of 1%
plot4 <- qplot(confidenceLevels, rules_sup1, geom=c("point", "line"),
xlab="Confidence level", ylab="Number of rules found",
main="Apriori with a support level of 1%") +
scale_y_continuous() +
theme_bw()
# Subplot
grid.arrange(plot1, plot2, plot3, plot4, ncol=2)Interpretemos los resultados del gráfico:
Con un nivel de soporte del 10%. Identificamos unas pocas reglas con niveles de confianza, por lo general, inferiores al 50%. Las reglas con confianza mayor del 50% son unas 50. No escogeremos este nivel de soporte.
Con un nivel de soporte del 5%. Empezamos a ver más reglas con alto nivel de confianza: +200 con confianza mayor del 50%.
Con un nivel de soporte del 3%. Tenemos una gran cantidad de reglas para este nivel, lo que complica demasiado el análisis (unas 400 con confianza mayor al 50%). No escogeremos este nivel de soporte.
Con un nivel de soporte del 1%. Muchas más reglas que en el apartado anterior (ahora ya del orden de 1000 con confianza mayor al 50%). Tampoco escogeremos este nivel de soporte.
En definitiva, usaremos un soporte del 5%, puesto que se obtiene un buen número de reglas con un nivel de confianza superior al 60%, lo cual es más que suficiente para el análisis que se pretende realizar. Escogemos reglas con longitud máxima 2 para obtener reglas de negocio fácilmente interpretables (del estilo si el cliente compra A, entonces compra B).
# 5% support
### solo longitud 1
association.rules <- apriori(tr, parameter = list(supp=0.05, conf=0.6,maxlen=2))## Apriori
##
## Parameter specification:
## confidence minval smax arem aval originalSupport maxtime support minlen
## 0.6 0.1 1 none FALSE TRUE 5 0.05 1
## maxlen target ext
## 2 rules FALSE
##
## Algorithmic control:
## filter tree heap memopt load sort verbose
## 0.1 TRUE TRUE FALSE TRUE 2 TRUE
##
## Absolute minimum support count: 196
##
## set item appearances ...[0 item(s)] done [0.00s].
## set transactions ...[907 item(s), 3924 transaction(s)] done [0.02s].
## sorting and recoding items ... [71 item(s)] done [0.00s].
## creating transaction tree ... done [0.00s].
## checking subsets of size 1 2 done [0.00s].
## writing ... [55 rule(s)] done [0.00s].
## creating S4 object ... done [0.00s].
Vemos las 10 reglas que tienen un mayor nivel de confianza:
summary(association.rules)## set of 55 rules
##
## rule length distribution (lhs + rhs):sizes
## 2
## 55
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 2 2 2 2 2 2
##
## summary of quality measures:
## support confidence lift count
## Min. :0.05046 Min. :0.6004 Min. :1.285 Min. : 198.0
## 1st Qu.:0.06205 1st Qu.:0.6066 1st Qu.:1.339 1st Qu.: 243.5
## Median :0.08002 Median :0.6257 Median :1.403 Median : 314.0
## Mean :0.10273 Mean :0.6323 Mean :1.446 Mean : 403.1
## 3rd Qu.:0.13685 3rd Qu.:0.6506 3rd Qu.:1.463 3rd Qu.: 537.0
## Max. :0.25841 Max. :0.7084 Max. :2.053 Max. :1014.0
##
## mining info:
## data ntransactions support confidence
## tr 3924 0.05 0.6
## ordenamos por confidence y count (ante empate). Mostramos las 10 primeras reglas.
top.confidence <- sort(association.rules, by=c("confidence", "count"), decreasing=TRUE)
inspect(head(top.confidence, 10))## lhs rhs support confidence lift count
## [1] {Mountain Gorgonzola} => {Tinto Reserva 95} 0.07492355 0.7084337 1.516582 294
## [2] {Scotch Whiskey 10 años} => {Tinto Reserva 95} 0.13965341 0.6858573 1.468251 548
## [3] {Queso de cabra} => {Tinto Reserva 95} 0.05555556 0.6833856 1.462960 218
## [4] {Blanc de Blancs Grand Cru} => {Brut Chardonnay Blanc de Blancs} 0.05045872 0.6804124 2.042799 198
## [5] {Mature Cheddar} => {Tinto Reserva 95} 0.13506626 0.6803594 1.456481 530
## [6] {Chenin Blanc 97} => {Tinto Reserva 95} 0.05886850 0.6794118 1.454453 231
## [7] {Swiss Emmental} => {Tinto Reserva 95} 0.08537207 0.6767677 1.448792 335
## [8] {Roquefort} => {Tinto Reserva 95} 0.13863405 0.6716049 1.437740 544
## [9] {Layden Gin} => {Tinto Reserva 95} 0.08409786 0.6680162 1.430058 330
## [10] {Chablis Chardonnay 97/98} => {Tinto Reserva 95} 0.13200815 0.6649551 1.423504 518
Conocimiento extraído: el 70 % de los que compran el queso Mountain Gorgonzola también compran el vino Tinto Reserva 95. Esto ocurre en el 7% del conjunto de los clientes del negocio, lo que se corresponde con 294 clientes.
Si ordenamos las reglas por count, es decir, por el número de clientes para las que se producen, obtenemos el siguiente resultado:
## ordenamos por confidence y count ante empate. Mostramos las 10 primeras reglas.
top.confidence <- sort(association.rules, by=c( "count"), decreasing=TRUE)
inspect(head(top.confidence, 10))## lhs rhs support
## [1] {Camembert} => {Tinto Reserva 95} 0.2584098
## [2] {Tinto Gran Reserva 91} => {Tinto Reserva 95} 0.2280836
## [3] {Bordeaux 97} => {Tinto Reserva 95} 0.2127931
## [4] {Manchego} => {Tinto Reserva 95} 0.2107543
## [5] {Merlot 97} => {Tinto Reserva 95} 0.1967380
## [6] {Parmigiano Reggiano} => {Tinto Reserva 95} 0.1954638
## [7] {Tiramisú} => {Chocolate Truffle} 0.1786442
## [8] {Chocolate Truffle} => {Tiramisú} 0.1786442
## [9] {Scotch Whiskey 18 años} => {Tinto Reserva 95} 0.1577472
## [10] {Dark Chocolate Digestives} => {Tinto Reserva 95} 0.1557085
## confidence lift count
## [1] 0.6010670 1.286736 1014
## [2] 0.6055480 1.296329 895
## [3] 0.6028881 1.290634 835
## [4] 0.6148699 1.316284 827
## [5] 0.6026542 1.290134 772
## [6] 0.6092137 1.304176 767
## [7] 0.6074523 2.053095 701
## [8] 0.6037898 2.053095 701
## [9] 0.6441207 1.378903 619
## [10] 0.6241062 1.336057 611
Descubrimos las reglas que involucran la trufa de chocolate y el tiramisú: más del 60% de los clientes que compran trufas de chocolate, también compran tiramisú, y viceversa.
En este apartado, se presentan algunas visualizaciones de las reglas construídas.
En primer lugar, visualizamos las 55 reglas de asociación que hemos obtenido. Se muestran los valores de confianza, lift y soporte.
plot(association.rules)Se presenta una visualización similar pero con la que se puede interactuar y saber qué productos representa cada regla. Esta visualización podría ser interesante para mostrar al cliente.
# vis. interactiva: https://journal.r-project.org/archive/2017/RJ-2017-047/RJ-2017-047.pdf
plot(association.rules, engine = "htmlwidget")Por último, se incluye una visualización en grafo para las 12 reglas con mayor nivel de confianza. De este modo, podemos observar los productos que desembocan en la compra de tinto reserva 95 junto con la cantidad de veces que ocurre la coincidencia.
subrules1 <- head(association.rules, n = 12, by = "confidence")plot(subrules1, method = "graph")En primer lugar, observamos diversas reglas que involucran al vino Tinto Reserva 95. Dichas reglas indican que gran cantidad de clientes que compran algún otro producto, también compran el mencionado vino. De entre dichas reglas, convendría destacar aquellas en las que el miembro izquierdo es un producto que no sea alcoholico (por ejemplo, Mountain Gorgonzola o Queso de Cabra). Una posible sugerencia sería colocar en las tiendas los productos no alcoholicos que aparecen en el miembro izquierdo de las 10 reglas que están ordenadas por nivel de confianza, junto al Tinto Reserva 95, en particular, y junto a la sección de vinos, en general.
Otra posibilidad sería ofrecer algún tipo de incentivo a los clientes que compren juntas ambas cosas: acumular más puntos, la creación de jornadas gastronómicas que junten vino y queso, entre otras.
En segundo lugar, observamos que las trufas de chocolate y el tiramisú son comprados juntos con una elevada frecuencia. Por tanto, se podrían recomendar medidas similares para dichos productos.